#  File src/library/tools/R/Rd2tex.R
#  Part of the R package, http://www.R-project.org
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  http://www.r-project.org/Licenses/

## TODO: can we do something useful with cross-package links?

latex_canonical_encoding  <- function(encoding)
{
    if (encoding == "") encoding <- localeToCharset()[1]
    encoding <- tolower(encoding)
    encoding <- sub("iso_8859-([0-9]+)", "iso-8859-\\1", encoding)
    encoding <- sub("iso8859-([0-9]+)", "iso-8859-\\1", encoding)

    encoding[encoding == "iso-8859-1"] <-  "latin1"
    encoding[encoding == "iso-8859-2"] <-  "latin2"
    encoding[encoding == "iso-8859-3"] <-  "latin3"
    encoding[encoding == "iso-8859-4"] <-  "latin4"
    encoding[encoding == "iso-8859-5"] <-  "cyrillic"
    encoding[encoding == "iso-8859-6"] <-  "arabic"
    encoding[encoding == "iso-8859-7"] <-  "greek"
    encoding[encoding == "iso-8859-8"] <-  "hebrew"
    encoding[encoding == "iso-8859-9"] <-  "latin5"
    encoding[encoding == "iso-8859-10"] <-  "latin6"
    encoding[encoding == "iso-8859-14"] <-  "latin8"
    encoding[encoding %in% c("latin-9", "iso-8859-15")] <-  "latin9"
    encoding[encoding == "iso-8859-16"] <-  "latin10"
    encoding[encoding == "utf-8"] <-  "utf8"
    encoding
}

## 'encoding' is passed to parse_Rd, as the input encoding
Rd2latex <- function(Rd, out="", defines=.Platform$OS.type, stages="render",
		     outputEncoding = "ASCII", ...)
{
    encode_warn <- FALSE
    WriteLines <-
        if(outputEncoding == "UTF-8" ||
           (outputEncoding == "" && l10n_info()[["UTF-8"]])) {
            function(x, con, outputEncoding, ...)
                writeLines(x, con, useBytes = TRUE, ...)
        } else {
            function(x, con, outputEncoding, ...) {
                x <- iconv(x, "UTF-8", outputEncoding,  mark=FALSE)
                if (any(is.na(x))) {
                    x <- iconv(x, "UTF-8", outputEncoding,
                               sub="byte", mark=FALSE)
                    encode_warn <<- TRUE
                }
                writeLines(x, con, useBytes = TRUE, ...)
            }
    }

    last_char <- ""
    of0 <- function(...) of1(paste(..., sep=""))
    of1 <- function(text) {
        nc <- nchar(text)
        last_char <<- substr(text, nc, nc)
        WriteLines(text, con, outputEncoding, sep = "")
    }

    trim <- function(x) {
        x <- psub1("^\\s*", "", as.character(x))
        psub1("\\s*$", "", x)
    }

    envTitles <- c("\\description"="Description", "\\usage"="Usage",
        "\\synopsis"="Usage", "\\arguments"="Arguments",
        "\\format"="Format", "\\details"="Details", "\\note"="Note",
        "\\section"="", "\\author"="Author",
        "\\references"="References", "\\source"="Source",
        "\\seealso"="SeeAlso", "\\examples"="Examples",
        "\\value"="Value")

    sectionExtras <-
    c("\\usage"="verbatim",
      "\\synopsis"="verbatim",
      "\\arguments"="ldescription",
      "\\examples"="ExampleCode")

    inCodeBlock <- FALSE ## used to indicate to vtexify where we are
    inCode <- FALSE
    inEqn <- FALSE
    inPre <- FALSE

    addParaBreaks <- function(x, tag) {
        start <- attr(x, "srcref")[2L]
        if (isBlankLineRd(x)) "\n"
	else if (start == 1) psub("^\\s+", "", x)
        else x
    }

    texify <- function(x) {
        if(inEqn) return(x)
        # Need to be careful to handle backslash, so do it in three steps.
        # First, mark all the ones in the original text, but don't add
        # any other special chars
        x <- fsub("\\", "\\bsl", x)
        # Second, escape other things, introducing more backslashes
        x <- psub("([&$%_#])", "\\\\\\1", x)
        ## pretty has braces in text.
        x <- fsub("{", "\\{", x)
        x <- fsub("}", "\\}", x)
        x <- fsub("^", "\\textasciicircum{}", x)
        x <- fsub("~", "\\textasciitilde{}", x)
        # Third, add the terminal braces to the backslash
        x <- fsub("\\bsl", "\\bsl{}", x)
        x
    }

    ## version for RCODE and VERB
    ## inCodeBlock/inPre is in alltt, where only \ { } have their usual meaning
    vtexify <- function(x, code = TRUE) {
        if(inEqn) return(x)
        ## cat(sprintf("vtexify: '%s'\n", x))
        x <- psub("\\\\[l]{0,1}dots", "...", as.character(x))
        ## unescape (should not be escaped: but see kappa.Rd)
        x <- psub("\\\\([$^&~_#])", "\\1", x)
        if (inCodeBlock) {
            ## We do want to escape { }, but unmatched braces had
            ## to be escaped in earlier versions (e.g. Paren.Rd, body.tex).
            ## So fix up for now
            x <- fsub1('"\\{"', '"{"', x)
        } else if (inPre) {
            BSL = '@BSL@';
            BSL2 = '@BSLBSL@';
            #x <- fsub("\\dots", "...", x)
            ## escape any odd \, e.g. \n
            x <- fsub("\\\\", BSL, x) # change even ones
            x <- fsub("\\", BSL2, x)  # odd ones
            x <- fsub(BSL, "\\\\", x) # change back
            x <- psub("(?<!\\\\)\\{", "\\\\{", x)
            x <- psub("(?<!\\\\)}", "\\\\}", x)
            x <- fsub(BSL2, "\\bsl{}", x)
            x <- psub("\\\\\\\\var\\\\\\{([^\\\\]*)\\\\}", "\\\\var{\\1}", x)
        } else {
            ## cat(sprintf("\nvtexify in: '%s'\n", x))
            BSL = '@BSL@';
            x <- fsub("\\", BSL, x)
            x <- psub("(?<!\\\\)\\{", "\\\\{", x)
            x <- psub("(?<!\\\\)}", "\\\\}", x)
            x <- psub("(?<!\\\\)([&$%_#])", "\\\\\\1", x)
            x <- fsub("^", "\\textasciicircum{}", x)
            x <- fsub("~", "\\textasciitilde{}", x)
            x <- fsub(BSL, "\\bsl{}", x)
            ## avoid conversion to guillemets
            x <- fsub("<<", "<{}<", x)
            x <- fsub(">>", ">{}>", x)
            x <- fsub(",,", ",{},", x) # ,, is a ligature in the ae font.
            ## used to preserve \var: needed in code only, or not at all
            if(FALSE) # was code
                x <- psub("\\\\bsl{}var\\\\{([^}]+)\\\\}", "\\\\var{\\1}", x)
            ## cat(sprintf("\nvtexify out: '%s'\n", x))
        }
	x
    }

    # The quotes were Rd.sty macros, but Latex limitations (e.g. nesting \preformatted within)
    # mean we get better results expanding them here.

    wrappers <- list("\\dQuote" =c("``", "''"),
    		     "\\sQuote" =c("`", "'"),
    		     "\\cite"   =c("\\Cite{", "}"))

    writeWrapped <- function(block, tag) {
    	wrapper <- wrappers[[tag]]
    	if (is.null(wrapper))
    	    wrapper <- c(paste(tag, "{", sep=""), "}")
    	of1(wrapper[1])
    	writeContent(block, tag)
    	of1(wrapper[2])
    }

    writeURL <- function(block, tag) {
        ## really verbatim
    	of0(tag, "{",
            gsub("\n", "", paste(as.character(block), collapse="")),
            "}")
    }

    ## Currently ignores [option] except for [=dest] form
    ## (as documented)
    writeLink <- function(tag, block) {
        parts <- get_link(block, tag)
        of0("\\LinkA{", latex_escape_link(parts$topic), "}{",
            latex_link_trans0(parts$dest), "}")
    }

    writeComment <- function(txt) of0(txt, '\n')

    writeDR <- function(block, tag) {
        if (length(block) > 1L) {
            of1('## Not run: ')
            writeContent(block, tag)
            of1('\n## End(Not run)')
        } else {
            of1('## Not run: ')
            writeContent(block, tag)
       }
    }

    ltxstriptitle <- function(x)
    {
        x <- fsub("\\R", "\\R{}", x)
        x <- psub("(?<!\\\\)([&$%_#])", "\\\\\\1", x)
        x <- fsub("^", "\\textasciicircum{}", x)
        x <- fsub("~", "\\textasciitilde{}", x)
        x
    }

    latex_escape_name <- function(x)
    {
        x <- psub("([$#~_&])", "\\\\\\1", x) #- escape them
        x <- fsub("{", "\\textbraceleft{}", x)
        x <- fsub("}", "\\textbraceright{}", x)
        x <- fsub("^", "\\textasciicircum{}", x)
        x <- fsub("~", "\\textasciitilde{}", x)
        x <- fsub("%", "\\Rpercent{}", x)
        x <- fsub("\\\\", "\\textbackslash{}", x)
        ## avoid conversion to guillemets
        x <- fsub("<<", "<{}<", x)
        x <- fsub(">>", ">{}>", x)
        x
    }

    latex_escape_link <- function(x)
    {
        ## _ is already escaped
        x <- fsub("\\_", "_", x)
        latex_escape_name(x)
    }

    latex_link_trans0 <- function(x)
    {
        x <- fsub("\\Rdash", ".Rdash.", x)
        x <- fsub("-", ".Rdash.", x)
        x <- fsub("\\_", ".Rul.", x)
        x <- fsub("\\$", ".Rdol.", x)
        x <- fsub("\\^", ".Rcaret.", x)
        x <- fsub("^", ".Rcaret.", x)
        x <- fsub("_", ".Rul.", x)
        x <- fsub("$", ".Rdol.", x)
        x <- fsub("\\#", ".Rhash.", x) #
        x <- fsub("#", ".Rhash.", x)   #
        x <- fsub("\\&", ".Ramp.", x)
        x <- fsub("&", ".Ramp.", x)
        x <- fsub("\\~", ".Rtilde.", x)
        x <- fsub("~", ".Rtilde.", x)
        x <- fsub("\\%", ".Rpcent.", x)
        x <- fsub("%", ".Rpcent.", x)
        x <- fsub("\\\\", ".Rbl.", x)
        x <- fsub("{", ".Rlbrace.", x)
        x <- fsub("}", ".Rrbrace.", x)
        x
    }

    latex_code_trans  <- function(x)
    {
        BSL = '@BSL@';
        LATEX_SPECIAL = '$^&~_#'
        if(grepl(LATEX_SPECIAL, x)) {
            x <- fsub("\\\\", BSL, x)
            ## unescape (should not be escaped)
            x <- psub("\\\\([$^&~_#])", "\\1", x)
            x <- psub("[$^&~_#]", "\\1&", x) #- escape them
            x <- fsub("^", "\\textasciicircum{}", x) # ^ is SPECIAL
            x <- fsub("~", "\\textasciitilde{}", x)
            x <- fsub(BSL, "\\bsl{}", x)
            x <- fsub("\\", "\\bsl{}", x)
        }
        ## avoid conversion to guillemets
        x <- fsub("<<", "<{}<", x)
        x <- fsub(">>", ">{}>", x)
        x <- fsub(",,", ",{},", x) # ,, is a ligature in the ae font.
        x <- psub("\\\\bsl{}var\\\\{([^}]+)\\\\}", "\\var{\\1}", x)
        x
}

    latex_link_trans <- function(x)
    {
        x <- fsub("<-.", "<\\Rdash.", x)
        x <- psub("<-$", "<\\Rdash", x)
        x
    }

    latex_code_alias <- function(x)
    {
        x <- fsub("{", "\\{", x)
        x <- fsub("}", "\\}", x)
        x <- psub("(?<!\\\\)([&$%_#])", "\\\\\\1", x)
        x <- fsub("^", "\\textasciicircum{}", x)
        x <- fsub("~", "\\textasciitilde{}", x)
        x <- fsub("<-", "<\\Rdash", x)
        x <- psub("([!|])", '"\\1', x)
        x
    }

    latex_code_aliasAA <- function(x)
    {
        x <- latex_code_trans(x)
        x <- latex_link_trans(x)
        psub("\\\\([!|])", '"\\1', x)
    }

    currentAlias <- NA_character_

    writeAlias <- function(block, tag) {
        alias <- as.character(block)
        aa <- "\\aliasA{"
        ## some versions of hyperref have trouble indexing these
        ## |, || in base, |.bit, %||% in ggplot2 ...
        if(grepl("|", alias, fixed = TRUE)) aa <- "\\aliasB{"
        if(is.na(currentAlias)) currentAlias <<- name
        if (pmatch(paste(currentAlias, ".", sep=""), alias, 0L)) {
            aa <- "\\methaliasA{"
        } else currentAlias <<- alias
        ## 'name' is linked from the header
        if (alias == name) return()
        alias2 <- latex_link_trans0(alias)
        of0(aa, latex_code_alias(alias), "}{",
            latex_escape_name(name), "}{", alias2, "}\n")
    }

    writeBlock <- function(block, tag, blocktag) {
	switch(tag,
               UNKNOWN =,
               VERB = of1(vtexify(block, FALSE)),
               RCODE = of1(vtexify(block, TRUE)),
               TEXT = of1(addParaBreaks(texify(block), blocktag)),
               COMMENT = {},
               LIST = writeContent(block, tag),
               "\\describe"= { # Avoid the Rd.sty \describe, \Enumerate and \Itemize:
               		       # They don't support verbatim arguments, which we might need.
                   of1("\\begin{description}\n")
                   writeContent(block, tag)
                   of1("\n\\end{description}\n")
               },
               "\\enumerate"={
                   of1("\\begin{enumerate}\n")
                   writeContent(block, tag)
                   of1("\n\\end{enumerate}\n")
               },
               "\\itemize"= {
                   of1("\\begin{itemize}\n")
                   writeContent(block, tag)
                   of1("\n\\end{itemize}\n")
               },
               ## Verbatim-like
               "\\command"=,
               "\\env" =,
               "\\kbd"=,
               "\\option" =,
               "\\samp" = writeWrapped(block, tag),
               ## really verbatim
                "\\url"= writeURL(block, tag),
               ## R-like
               "\\code"= {
                   inCode <<- TRUE
                   writeWrapped(block, tag)
                   inCode <<- FALSE
               },
               ## simple wrappers
               "\\acronym" =,
               "\\bold"=,
               "\\dfn"=,
               "\\dQuote"=,
               "\\email"=,
               "\\emph"=,
               "\\file" =,
               "\\pkg" =,
               "\\sQuote" =,
               "\\strong"=,
               "\\var" =,
               "\\cite" =
                   if (inCodeBlock) writeContent(block, tag)
                   else writeWrapped(block, tag),
               "\\preformatted"= {
                   inPre <<- TRUE
                   of1("\\begin{alltt}")
                   writeContent(block, tag)
                   of1("\\end{alltt}\n")
                   inPre <<- FALSE
               },
               "\\Sexpr"= { of1("\\begin{verbatim}\n")  # This is only here if processing didn't get it...
	       	            of0(as.character.Rd(block, deparse=TRUE))
	       	            of1("\n\\end{verbatim}\n")
	       	          },

               "\\verb"= {
                   of0("\\AsIs{")
                   writeContent(block, tag)
                   of1("}")
               },
               "\\special"= writeContent(block, tag), ## FIXME, verbatim?
               "\\linkS4class" =,
               "\\link" = writeLink(tag, block),
               "\\cr" = of1("\\\\{}"), ## might be followed by [
               "\\dots" =,
               "\\ldots" = of1(if(inCode || inCodeBlock) "..."  else tag),
               "\\R" = of0(tag, "{}"),
               "\\donttest" = writeContent(block, tag),
               "\\dontrun"= writeDR(block, tag),
               "\\enc" = { # some people put more things in \enc than a word.
                   writeContent(block[[1L]], tag)
                   ##txt <- as.character(block[[1L]])
                   ##of1(txt)
               } ,
               "\\eqn" =,
               "\\deqn" = {
                   of0(tag, "{")
                   inEqn <<- TRUE
                   writeContent(block[[1L]], tag)
                   inEqn <<- FALSE
                   of0('}{}')
               },
               "\\dontshow" =,
               "\\testonly" = {}, # do nothing
               "\\method" =,
               "\\S3method" = {
                   ## should not get here
               },
               "\\S4method" = {
                   of1("## S4 method for signature '")
                   writeContent(block[[2L]], tag)
                   of1("':\n")
                   writeContent(block[[1L]], tag)
               },
               "\\tabular" = writeTabular(block),
               "\\if" =,
               "\\ifelse" =
		    if (testRdConditional("latex", block, Rdfile))
               		writeContent(block[[2L]], tag)
               	    else if (tag == "\\ifelse")
               	    	writeContent(block[[3L]], tag),
               "\\out" = for (i in seq_along(block))
		   of1(block[[i]]),
               stopRd(block, Rdfile, "Tag ", tag, " not recognized")
               )
    }

    writeTabular <- function(table) {
        ## FIXME does no check of correct format
    	format <- table[[1L]]
    	content <- table[[2L]]
    	if (length(format) != 1 || RdTags(format) != "TEXT")
    	    stopRd(table, Rdfile, "\\tabular format must be simple text")
        tags <- RdTags(content)
        of0('\n\\Tabular{', format, '}{')
        for (i in seq_along(tags)) {
            switch(tags[i],
                   "\\tab" = of1("&"),
                   "\\cr" = of1("\\\\{}"),
                   writeBlock(content[[i]], tags[i], "\\tabular"))
        }
        of1('}')
    }

    writeContent <- function(blocks, blocktag) {
        inList <- FALSE
        itemskip <- FALSE

	tags <- RdTags(blocks)

	for (i in seq_along(tags)) {
            block <- blocks[[i]]
            tag <- attr(block, "Rd_tag")
            ## this should not be null, but it might be in a erroneous Rd file
            if(!is.null(tag))
            switch(tag,
                   "\\method" =,
                   "\\S3method" = {
                       class <- as.character(block[[2L]])
                       generic <- as.character(block[[1L]])
                       ## R.huge has
                       ## \method{[}{FileMatrix}(this, i, j, drop=FALSE)
                       if (length(blocks) > 2L &&
                           generic %in% c("[", "[[", "$")) {
                           ## need to assemble the call
                           j <- i + 1L
                           txt <- ""
                           repeat {
                               this <- switch(tg <- attr(blocks[[j]], "Rd_tag"),
                                              "\\ldots" =, # not really right
                                              "\\dots" = "...",
                                              RCODE = as.character(blocks[[j]]),
                                              stopRd(block, Rdfile, sprintf("invalid markup '%s' in %s", tg, tag)))
                               txt <- paste(txt, this, sep = "")
                               blocks[[j]] <- structure("", Rd_tag = "COMMENT")
                               if(grepl("\n$", txt)) {
                                   res <- try(parse(text = paste("a", txt)))
                                   if(!inherits(res, "try-error")) break
                               }
                               j <- j + 1L
                           }
                           #print(txt)
                           txt <- psub1("\\(([^,]*),\\s*", "\\1@generic@", txt)
                           txt <- fsub1("@generic@", generic, txt)
                           if (generic == "[")
                               txt <- psub1("\\)([^)]*)$", "]\\1", txt)
                           else if (generic == "[[")
                               txt <- psub1("\\)([^)]*)$", "]]\\1", txt)
                           else if (generic == "$")
                               txt <- psub1("\\)([^)]*)$", "\\1", txt)
                           #print(txt)
                           if (grepl("<-\\s*value", txt))
                               of1("## S3 replacement method for class '")
                           else
                               of1("## S3 method for class '")
                           writeContent(block[[2L]], tag)
                           of1("':\n")
                           blocks[[i+1L]] <- structure(txt, Rd_tag = "RCODE")
                       } else {
                           if (class == "default")
                               of1('## Default S3 method:\n')
                           else if (grepl("<-\\s*value", blocks[[i+1]][[1L]])) {
                               of1("## S3 replacement method for class '")
                               writeContent(block[[2L]], tag)
                               of1("':\n")
                           } else {
                               of1("## S3 method for class '")
                               writeContent(block[[2L]], tag)
                               of1("':\n")
                           }
                           writeContent(block[[1L]], tag)
                       }
                   },
                   "\\item" = {
                       if (blocktag == "\\value" && !inList) {
                           of1("\\begin{ldescription}\n")
                           inList <- TRUE
                       }
                       switch(blocktag,
                              "\\describe" = {
                                  of1('\\item[')
                                  writeContent(block[[1L]], tag)
                                  of1('] ')
                                  writeContent(block[[2L]], tag)
                              },
                              "\\value"=,
                              "\\arguments"={
                                  of1('\\item[\\code{')
                                  inCode <<- TRUE
                                  writeContent(block[[1L]], tag)
                                  inCode <<- FALSE
                                  of1('}] ')
                                  writeContent(block[[2L]], tag)
                              },
                              "\\enumerate" =,
                              "\\itemize"= {
                                  of1("\\item ")
                                  itemskip <- TRUE
                              })
                       itemskip <- TRUE
                   },
                   "\\cr" = of1("\\\\{}"), ## might be followed by [
               { # default
                   if (inList && !(tag == "TEXT" && isBlankRd(block))) {
                       of1("\\end{ldescription}\n")
                       inList <- FALSE
                   }
                   if (itemskip) {
                       ## The next item must be TEXT, and start with a space.
                       itemskip <- FALSE
                       if (tag == "TEXT") {
                           txt <- psub("^ ", "", as.character(block))
                           of1(texify(txt))
                       } else writeBlock(block, tag, blocktag) # should not happen
                   } else writeBlock(block, tag, blocktag)
               })
	}
        if (inList) of1("\\end{ldescription}\n")
    }

    writeSectionInner <- function(section, tag)
    {
        if (length(section)) {
	    ## need \n unless one follows, so
	    nxt <- section[[1L]]
	    if (!attr(nxt, "Rd_tag") %in% c("TEXT", "RCODE") ||
		substr(as.character(nxt), 1L, 1L) != "\n") of1("\n")
	    writeContent(section, tag)
	    inCodeBlock <<- FALSE
	    if (last_char != "\n") of1("\n")
	}
    }

    writeSection <- function(section, tag) {
        if (tag %in% c("\\encoding", "\\concept"))
            return()
        if (tag == "\\alias")
            writeAlias(section, tag)
        else if (tag == "\\keyword") {
            key <- trim(section)
            of0("\\keyword{", latex_escape_name(key), "}{", ltxname, "}\n")
        } else if (tag == "\\section") {
            of0("%\n\\begin{Section}{")
            writeContent(section[[1L]], tag)
            of1("}")
    	    writeSectionInner(section[[2L]], tag)
            of1("\\end{Section}\n")
    	} else {
            title <- envTitles[tag]
            of0("%\n\\begin{", title, "}")
            if(tag %in% c("\\author", "\\description", "\\details", "\\note",
                          "\\references", "\\seealso", "\\source"))
                of1("\\relax")
            extra <- sectionExtras[tag]
            if(!is.na(extra)) of0("\n\\begin{", extra, "}")
            if(tag %in% c("\\usage", "\\examples")) inCodeBlock <<- TRUE
            writeSectionInner(section, tag)
 	    inCodeBlock <<- FALSE
            if(!is.na(extra)) of0("\\end{", extra, "}\n")
            of0("\\end{", title, "}\n")
        }
    }

    Rd <- prepare_Rd(Rd, defines=defines, stages=stages, ...)
    Rdfile <- attr(Rd, "Rdfile")
    sections <- RdTags(Rd)

    enc <- which(sections == "\\encoding")
    if (length(enc)) outputEncoding <- as.character(Rd[[enc[1L]]][[1L]])

    if (is.character(out)) {
        if(out == "") {
            con <- stdout()
        } else {
	    con <- file(out, "wt")
	    on.exit(close(con))
	}
    } else {
    	con <- out
    	out <- summary(con)$description
    }

   if (outputEncoding != "ASCII") {
        latexEncoding <- latex_canonical_encoding(outputEncoding)
        of0("\\inputencoding{", latexEncoding, "}\n")
    } else latexEncoding <- NA

    ## we know this has been ordered by prepare2_Rd, but
    ## need to sort the aliases (if any)
    nm <- character(length(Rd))
    isAlias <- sections == "\\alias"
    sortorder <- if (any(isAlias)) {
        nm[isAlias] <- sapply(Rd[isAlias], as.character)
        order(sectionOrder[sections], toupper(nm), nm)
    } else  order(sectionOrder[sections])
    Rd <- Rd[sortorder]
    sections <- sections[sortorder]

    title <- as.character(Rd[[1L]])
    ## remove empty lines, leading whitespace
    title <- trim(paste(psub1("^\\s+", "", title[nzchar(title)]),
                        collapse=" "))
    ## substitutions?

    name <- Rd[[2L]]

    name <- trim(as.character(Rd[[2L]][[1L]]))
    ltxname <- latex_escape_name(name)

    of0('\\HeaderA{', ltxname, '}{',
        ltxstriptitle(title), '}{',
        latex_link_trans0(name), '}\n')

    for (i in seq_along(sections)[-(1:2)])
        writeSection(Rd[[i]], sections[i])

    if (encode_warn)
        warnRd(Rd, Rdfile, "Some input could not be re-encoded to ",
               outputEncoding)
    invisible(structure(out, latexEncoding = latexEncoding))
}
